home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol033 / rpn.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-11  |  2.6 KB  |  65 lines
  1. 5000 REM  RPN calculator program
  2. 5010 CLS:LOCATE 2,5
  3. 5020 PRINT"use <CR> for enter"
  4. 5030 PRINT"     *   for multiplication"
  5. 5040 PRINT"     /   for division"
  6. 5050 PRINT"     Q   for square root"
  7. 5060 PRINT"     S   for sine"
  8. 5070 PRINT"     C   for cosine"
  9. 5080 PRINT"     T   for tangent"
  10. 5090 PRINT"     E   for e to the x"
  11. 5100 PRINT"     N   for log(e) x"
  12. 5110 PRINT"     L   for log(10) x"
  13. 5120 '
  14. 5122 '
  15. 5124 '
  16. 5126 '
  17. 5128 '
  18. 5129 PRINT"     D   to delete entry"
  19. 5130 PRINT"   <Esc> to end program"
  20. 5140 '
  21. 5150 KEY OFF: DEF SEG=&H40: POKE &H17,PEEK(&H17) OR 32  ' set numlock ON
  22. 5160 R=1.745329E-02: F$="########.###" 'degree radian conv. and format
  23. 5170 ' main key query section
  24. 5180 A$=INKEY$: IF A$="" THEN 5180 ELSE P=ASC(A$):LOCATE 23,10: PRINT P
  25. 5190 IF P>47 AND P<58 OR A$="." THEN 5210 ELSE 5230  'check for numbers
  26. 5200 ' update number entry
  27. 5210 N$=N$+A$: LOCATE 10,50: PRINT SPC(20);:LOCATE 10,50:PRINT N$;:GOTO 5180
  28. 5215 '
  29. 5220 ' arithmetic processing below here
  30. 5230 IF P=13 THEN 5240 ELSE 5270  'carriage return, enter data
  31. 5240 GOSUB 5260: GOTO 5450
  32. 5250 ' raise stack, re-position for function printout
  33. 5260 T=Z:Z=Y:Y=X: X=VAL(N$): N$="":LOCATE 9,50:PRINT SPC(10):LOCATE 9,50:RETURN
  34. 5270 IF N$="" THEN N$=STR$(X):X=Y:Y=Z:Z=T:T=0 'if no number pressed,lower stack
  35. 5275 '
  36. 5280 IF P=43 THEN GOSUB 5260: PRINT "+": X=X+Y:Y=Z:Z=T: GOTO 5450
  37. 5290 IF P=45 THEN GOSUB 5260: PRINT "-": X=Y-X:Y=Z:Z=T: GOTO 5450
  38. 5300 IF P=42 THEN GOSUB 5260: PRINT "x": X=Y*X:Y=Z:Z=T: GOTO 5450
  39. 5310 IF P=47 THEN GOSUB 5260: PRINT CHR$(246): X=Y/X:Y=Z:Z=T: GOTO 5450
  40. 5320 IF A$="Q" OR A$="q" THEN GOSUB 5260: PRINT CHR$(251): X=SQR(X): GOTO 5450
  41. 5330 IF A$="S" OR A$="s" THEN GOSUB 5260: PRINT "sin": X=SIN(X*R): GOTO 5450
  42. 5340 IF A$="C" OR A$="c" THEN GOSUB 5260: PRINT "cos": X=COS(X*R): GOTO 5450
  43. 5350 IF A$="T" OR A$="t" THEN GOSUB 5260: PRINT "tan": X=TAN(X*R): GOTO 5450
  44. 5360 IF A$="E" OR A$="e" THEN GOSUB 5260: PRINT "exp": X=EXP(X): GOTO 5450
  45. 5370 IF A$="n" OR A$="N" THEN GOSUB 5260: PRINT "ln": X=LOG(X): GOTO 5450
  46. 5380 IF A$="L" OR A$="l" THEN GOSUB 5260: PRINT "log": X=LOG(X)/LOG(10):GOTO 5450
  47. 5382 '
  48. 5384 '
  49. 5386 '
  50. 5390 '
  51. 5398 IF A$="d" OR A$="D" THEN N$="":GOTO 5450 ELSE 5400
  52. 5400 GOSUB 5260 'if no valid function pressed re-raise stack
  53. 5410 IF ASC(A$)=27 THEN 5420 ELSE 5430 'check for Esc key
  54. 5420 DEF SEG=&H40:POKE &H17,PEEK(&H17) AND 223: CLS: KEY ON: END 'exit
  55. 5430 GOTO 5450
  56. 5440 '
  57. 5450 REM  stack update to screen
  58. 5460 LOCATE 10,50: PRINT SPC(20)
  59. 5470 LOCATE 5,50: PRINT USING F$;T
  60. 5480 LOCATE 6,50: PRINT USING F$;Z
  61. 5490 LOCATE 7,50: PRINT USING F$;Y
  62. 5500 LOCATE 8,50: PRINT USING F$;X
  63. 5510 GOTO 5180
  64. T
  65. 548